home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / dtl / as_proc.cod < prev    next >
Encoding:
Text File  |  1993-03-09  |  12.4 KB  |  446 lines
  1. //
  2. // Module name: as_proc.cod
  3. // Description: Procedure file for the generated application
  4. //
  5. *{replicate("-",79)}
  6. * Description..: Procedure files for generated menu system.
  7. * The programs that follow are common to main routines
  8. * The last procedure is the Menu Process DEFinition
  9. *{replicate("-",79)}
  10.  
  11. PROCEDURE Lockit
  12. PARAMETER pc_ltype
  13. *{replicate("-",69)}
  14. * Lock the current file or record based on the value of <pc_ltype>.
  15. *{replicate("-",69)}
  16.   IF NETWORK()
  17.     gn_error=0
  18.     ON ERROR DO Multerr
  19.     IF pc_ltype = "1"
  20.       ll_lock=FLOCK()
  21.     ENDIF
  22.     IF pc_ltype = "2"
  23.       ll_lock=RLOCK()
  24.     ENDIF
  25.     ON ERROR
  26.   ENDIF
  27. RETURN
  28. *-- EOP: Lockit WITH pc_ltype
  29.  
  30. PROCEDURE Info_Box
  31. PARAMETERS pc_say
  32. *{replicate("-",69)}
  33. * Display the message <pc_say> inside of boxes.
  34. *{replicate("-",69)}
  35.   ? pc_say
  36.   ? REPLICATE("-",LEN(pc_say))
  37.   ?
  38. RETURN
  39. *--EOP: Info_Box WITH pc_say
  40.  
  41. PROCEDURE ShowPick
  42. *{replicate("-",69)}
  43. * Show pick list values.
  44. *{replicate("-",69)}
  45.   PRIVATE ln_ikey, x1, x2
  46.  
  47.   listval=PROMPT()
  48.   IF LEFT(entryflg,1)="B"
  49.     lc_file=POPUP()
  50.     DO &lc_file. WITH "A"
  51.     RETURN
  52.   ENDIF
  53.   IF TYPE("lc_window")="U"
  54.     ACTIVATE WINDOW ShowPick
  55.   ELSE
  56.     ACTIVATE WINDOW &lc_window.
  57.   ENDIF
  58.  
  59.   STORE 0 TO ln_ikey,x1,x2
  60.   ln_ikey=LASTKEY()
  61.   IF ln_ikey=13
  62.     x1=AT(TRIM(listval)+',',lc_fldlst)
  63.     IF x1 = 0
  64.       lc_fldlst=lc_fldlst+TRIM(listval)+','
  65.     ELSE
  66.       x2=AT(',',SUBSTR(lc_fldlst,x1))
  67.       lc_fldlst=STUFF(lc_fldlst,x1,x2,'')
  68.     ENDIF
  69.     CLEAR
  70.     ? lc_fldlst
  71.   ENDIF
  72.   ACTIVATE SCREEN
  73.  
  74. RETURN
  75. *--EOP: ShowPick
  76.  
  77. {  include "as_clnup.cod";}
  78. {  include "as_pause.cod";}
  79. {  include "as_muser.cod";}
  80. {  include "as_trce.cod";}
  81. {  include "as_prin.cod";}
  82. {  include "as_posit.cod";}
  83. PROCEDURE BefAct
  84. *{replicate("-",69)}
  85. * Save the screen before executing a menu option.
  86. *{replicate("-",69)}
  87.   SAVE SCREEN TO Browscr&lc_ApGen.
  88.   DEACTIVATE WINDOW Fullscr
  89.   SET SCOREBOARD ON
  90. RETURN
  91. *--EOP: BefAct
  92.  
  93. PROCEDURE AftAct
  94. *{replicate("-",69)}
  95. * Restore the screen after executing a menu option.
  96. *{replicate("-",69)}
  97.   CLEAR
  98.   SET SCOREBOARD OFF
  99.   ACTIVATE WINDOW Fullscr
  100.   RESTORE SCREEN FROM Browscr&lc_ApGen.
  101.   RELEASE SCREEN Browscr&lc_ApGen.
  102. RETURN
  103. *--EOP: AftAct
  104.  
  105. PROCEDURE Postnhlp
  106. *{replicate("-",69)}
  107. * Display help screens for generic menus.
  108. *{replicate("-",69)}
  109.   DEFINE WINDOW Temphelp FROM 3,12 TO 19,67
  110.   ACTIVATE WINDOW Temphelp
  111.   DO CASE
  112.     CASE "SEEK" $ PROMPT()
  113.     *-- HELP SEEK
  114.       ? " SEEK <exp>"
  115.       ?
  116.       ? " Evaluates a specified expression and attempts to"
  117.       ? " find its value in the master index of the database"
  118.       ? " file.  Returns a logical true (.T.) if the index"
  119.       ? " key is found, and a logical false (.F.) if it is"
  120.       ? " not found."
  121.       ?
  122.       ? " Ex: SEEK CTOD('11/03/87')  -  converts the"
  123.       ? "     expression from character to date and"
  124.       ? "     then searches for the value in the index"
  125.       ?
  126.     CASE LEFT(LTRIM(PROMPT()),4) $ "GOTO TOP BOTT Reco"
  127.     *-- HELP GOTO
  128.       ? " GO/GOTO BOTTOM/TOP [IN <alias>]"
  129.       ? " or"
  130.       ? " GO/GOTO [RECORD] <record number> [IN <alias>]"
  131.       ? " or"
  132.       ? " <record number>"
  133.       ?
  134.       ? " Positions the record pointer to a specified record"
  135.       ? " or location in the active database file."
  136.       ?
  137.       ? "      TOP moves the pointer to the first record"
  138.       ? "      BOTTOM moves the pointer to the last record"
  139.       ?
  140.       ? " Ex: 4  -  moves the record pointer to record 4"
  141.       ?
  142.     CASE "LOCATE" $ PROMPT()
  143.     *-- HELP LOCATE
  144.       ? " LOCATE FOR <condition> [<scope>]"
  145.       ? "      [WHILE <condition>]"
  146.       ?
  147.       ? " Searches the active database file, sequentially,"
  148.       ? " for the first record that meets the specified"
  149.       ? " criteria.  The function FOUND() returns true (.T.)"
  150.       ? " if LOCATE is successful."
  151.       ?
  152.       ? " Ex: LOCATE FOR Age = '25' NEXT 5"
  153.       ? "     searches for the next five records"
  154.       ? "     containing 25 in the Age field"
  155.       ?
  156.     CASE "Change index order" $ PROMPT() .OR. POPUP() = "SHOWTAG"
  157.       ?
  158.       ? [ Select "Change index order" to select the master]
  159.       ? " (controlling) index. You will see a list of indexes"
  160.       ? " from the  stand-alone indexes (.ndx). and mdx"
  161.       ? " file(s) that are activated. The first option in the"
  162.       ? " list, NATURAL ORDER, uses the file in its unindexed"
  163.       ? " state.  Press RETURN to select your choice by which"
  164.       ? " to order the file."
  165.       ?
  166.   ENDCASE
  167.  
  168.   DO Wait4Key
  169.  
  170.   DEACTIVATE WINDOW Temphelp
  171.   RELEASE WINDOW Temphelp
  172. RETURN
  173. *--EOP: Postnhlp
  174.  
  175. PROCEDURE Wait4Key
  176. *{replicate("-",69)}
  177. * Wait for a key press or mouse click.
  178. *{replicate("-",69)}
  179.   PRIVATE ll_escape
  180.  
  181.   ll_escape = SET( "ESCAPE" ) = "ON"
  182.   SET ESCAPE OFF
  183.   WAIT
  184.   IF ll_escape
  185.     SET ESCAPE ON
  186.   ENDIF
  187.  
  188. RETURN
  189. *-- EOP: Wait4Key
  190.  
  191. FUNCTION Color
  192. PARAMETERS pc_scolor
  193. *---------------------------------------------------------------------------
  194. * Format:
  195. * COLOR( <expC> )
  196. *  <expC> = NORMAL, HIGHLIGHT, MESSAGES, TITLES, BOX, INFORMATION, FIELDS
  197. *        or a variable with all colors store in it
  198. *  Ver: dBASE 1.1
  199. *
  200. * The COLOR() function either returns or sets colors returned with the
  201. * SET("attribute") setting
  202. * If <expC> is a color string then null is returned otherwise the color
  203. * setting is returned for one of dBASE's color options
  204. *
  205. * See Also: SET("attribute")
  206. *
  207. *---------------------------------------------------------------------------
  208. PRIVATE color_num, color_str, cnt
  209.  
  210. pc_scolor = UPPER(pc_scolor)
  211. IF pc_scolor = "COLOR"
  212.   *- Return standard, enhanced, border colors only
  213.   RETURN SUBSTR(SET("attr"),1, AT(" &", SET("attr")))
  214. ENDIF
  215.  
  216. *- Declare array to parse color options from SET("attr")
  217. PRIVATE color_
  218. DECLARE color_[8]
  219. *- Determine if user is restoring colors vs. saving colors
  220. IF " &" $ pc_scolor
  221.   color_str = ","+pc_scolor+","                  && Restore color attributes
  222. ELSE
  223.   color_str = ","+SET("ATTRIBUTE")+","           && Save color attributes
  224. ENDIF
  225.  
  226. *-- Stuff array with individual color setting
  227. color_str = STUFF(color_str, AT(" &", color_str), 4, ",")
  228. cnt = 1
  229. DO WHILE cnt <= 8
  230.   color_str = SUBSTR(color_str, AT(",", color_str ) +1 )
  231.   color_[cnt] = SUBSTR(color_str, 1, AT(",", color_str ) - 1)
  232.   cnt = cnt + 1
  233. ENDDO
  234.  
  235. IF " &" $ pc_scolor
  236.   *-- Set color back
  237.   SET COLOR TO ,,&color_[3].                     && Border color
  238.   SET COLOR OF NORMAL TO &color_[1].
  239.   SET COLOR OF HIGHLIGHT TO &color_[2].
  240.   SET COLOR OF MESSAGES TO &color_[4].
  241.   SET COLOR OF TITLES TO &color_[5].
  242.   SET COLOR OF BOX TO &color_[6].
  243.   SET COLOR OF INFORMATION TO &color_[7].
  244.   SET COLOR OF FIELDS TO &color_[8].
  245. ELSE
  246.   *-- Return color string requested
  247.   DO CASE
  248.     CASE pc_scolor $ "NORMAL"
  249.       color_num =  1
  250.     CASE pc_scolor $ "HIGHLIGHT"
  251.       color_num =  2
  252.     CASE pc_scolor $ "BORDER"
  253.       color_num =  3
  254.     CASE pc_scolor $ "MESSAGES"
  255.       color_num =  4
  256.     CASE pc_scolor $ "TITLES"
  257.       color_num =  5
  258.     CASE pc_scolor $ "BOX"
  259.       color_num =  6
  260.     CASE pc_scolor $ "INFORMATION"
  261.       color_num =  7
  262.     CASE pc_scolor $ "FIELDS"
  263.       color_num =  8
  264.   ENDCASE
  265. ENDIF
  266. RETURN IIF(" &" $ pc_scolor, "", color_[color_num])
  267.  
  268. FUNCTION _NodShake
  269. PARAMETERS pc_mssg, pn_up, pn_left, pn_height, pn_max, pl_dflt_no
  270. *---------------------------------------------------------------------------
  271. * NAME
  272. *   _NodShake
  273. *
  274. * DESCRIPTION
  275. *   Accepts a YES/NO response from user
  276. *
  277. * SYNOPSIS
  278. *   DO _NodShake WITH pc_mssg, pn_up, pn_left, pn_height, pn_max, pl_dflt_no
  279. *
  280. * PARAMETERS
  281. *   pc_mssg:    dialog box message
  282. *   pn_up:      upper corrdinate of dialog box
  283. *   pn_left:    left coordinate of dialog box
  284. *   pn_height:  height of dialog box
  285. *   pn_max:     maximum width of a line in message
  286. *   pl_dflt_no: flag indicating if default pad highlighted should be "NO"
  287. *       
  288. * EXAMPLE
  289. *    pl_set = _NodShake( pc_vermssg, 13, 25, 2, 28, .T. )
  290. *---------------------------------------------------------------------------
  291.  
  292.   PRIVATE ll_ans, ll_console, ll_wrapset, ln_pspset
  293.  
  294.   ll_console = SET( "CONSOLE" ) = "OFF"
  295.   SET CONSOLE ON
  296.   ll_wrapset = _wrap
  297.   ln_pspset = _pspacing
  298.   _wrap = .F.
  299.   _pspacing = 1
  300.  
  301.   DEFINE WINDOW NodShake DOUBLE ;
  302.      FROM pn_up, pn_left TO pn_up + pn_height + 4, pn_left + pn_max + 1
  303.  
  304.   DEFINE MENU NodShake
  305.   DEFINE PAD Yes OF NodShake PROMPT "Yes" ;
  306.      AT pn_height + 1, (pn_max - 12) / 2;
  307.      MESSAGE "Select option and press ENTER, or press first letter" + ;
  308.              " of desired option"
  309.  
  310.   ON SELECTION PAD Yes OF NodShake DEACTIVATE MENU
  311.   DEFINE PAD No OF NodShake PROMPT "No" ;
  312.      AT pn_height + 1, (pn_max - 12) / 2 + 10 ;
  313.      MESSAGE "Select option and press ENTER, or press first letter" + ;
  314.              " of desired option"
  315.  
  316.   ON SELECTION PAD No OF NodShake DEACTIVATE MENU
  317.   ACTIVATE WINDOW NodShake
  318.   CLEAR
  319.   ?
  320.   @ 0, 0
  321.   ?? pc_mssg FUNCTION ";"
  322.  
  323.   ON KEY LABEL Y KEYBOARD "\{Alt-Y}\{13}"
  324.   ON KEY LABEL N KEYBOARD "\{Alt-N}\{13}"
  325.  
  326.   IF pl_dflt_no
  327.     KEYBOARD "\{Alt-N}"
  328.   ENDIF
  329.  
  330.   ON KEY LABEL RIGHTARROW
  331.   ON KEY LABEL LEFTARROW
  332.  
  333.   ACTIVATE MENU NodShake
  334.  
  335.   ON KEY LABEL Y
  336.   ON KEY LABEL N
  337.  
  338.   IF PAD() = "YES"
  339.     ll_ans = .T.
  340.   ELSE
  341.     ll_ans = .F.
  342.   ENDIF
  343.  
  344.   RELEASE WINDOW NodShake
  345.   RELEASE MENU NodShake
  346.   _wrap = ll_wrapset
  347.   _pspacing = ln_pspset
  348.  
  349.   IF ll_console
  350.     SET CONSOLE OFF
  351.   ENDIF
  352.  
  353. RETURN ll_ans
  354. *-- EOF: _NodShake( pc_mssg, pn_up, pn_left, pn_height, pn_max, pl_dflt_no )
  355.  
  356.  
  357. PROCEDURE _Err_Box
  358. PARAMETERS pc_msg
  359. *----------------------------------------------------------------------------
  360. * NAME
  361. *   _Err_Box - Display an error box
  362. *
  363. * SYNOPSIS
  364. *   DO _Err_Box WITH <pc_msg>
  365. *
  366. * DESCRIPTION
  367. *   _Err_Box will display the <pc_msg> string in a box and prompt the
  368. *   user to press any key to continue processing.  _Err_Box will display
  369. *   the message based on the length of <pc_msg>.
  370. *
  371. * PARAMETERS
  372. *   pc_msg - the error message to display in the box.  If the length is
  373. *            greater than 76, the trailing part is chopped off.
  374. *
  375. * EXAMPLE
  376. *   DO _Err_Box WITH "Incorrect window size"
  377. *   Displays the message in a window as follows at row 9 on the screen:
  378. *                      +------------------------------+
  379. *                      |                              |
  380. *                      |    Incorrect window size     |
  381. *                      |                              |
  382. *                      | Press any key to continue... |
  383. *                      |                              |
  384. *                      +------------------------------+
  385. *   Note that the width of the window will increase to accommodate a longer
  386. *   message string.
  387. *
  388. * LIMITATIONS
  389. *   Truncates the message after 76 characters.  Assumes an 80 character
  390. *   wide screen.  Looks best with SET CURSOR OFF.
  391. *
  392. *----------------------------------------------------------------------------
  393.  
  394.   PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,;
  395.           ll_escape
  396.  
  397.   lc_anykey = [Press any key to continue...]
  398.   ln_press  = LEN( lc_anykey )
  399.   lc_win = WINDOW()                     && Currently activated window if any
  400.   lc_msg = LTRIM( RTRIM( pc_msg ) )     && Trimmed message
  401.   ln_msglen = LEN( lc_msg )             && Trimmed length of message
  402.   ln_width = 0                          && Width of display area in window.
  403.   ll_escape = SET("ESCAPE") = "ON"
  404.   SET ESCAPE OFF
  405.  
  406.   *-- Determine the width needed for the window:
  407.   IF ln_msglen <= ln_press
  408.     ln_width = ln_press
  409.   ELSE
  410.     *-- Make sure the message fits in the window:
  411.     IF ln_msglen > 76
  412.       lc_msg = LEFT( lc_msg, 76 )
  413.       ln_msglen = 76
  414.     ENDIF
  415.     ln_width = ln_msglen
  416.   ENDIF
  417.   DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ;
  418.                 TO 15, (ln_width + 83) / 2 DOUBLE
  419.   ln_width = ( ln_width + 2 )
  420.  
  421.   *-- Display the message and prompt to the window and wait for a key press
  422.   ACTIVATE WINDOW _err_box
  423.   @ 1, ( ln_width - ln_msglen ) / 2 SAY lc_msg
  424.   @ 3, ( ln_width - ln_press ) / 2 SAY lc_anykey
  425.   SET CONSOLE OFF                       && For mouse click recognition
  426.   WAIT
  427.   SET CONSOLE ON
  428.  
  429.   *-- Clean up the window display and reactivate the previous window
  430.   RELEASE WINDOW _err_box
  431.   IF ISBLANK( lc_win )
  432.     ACTIVATE SCREEN
  433.   ENDIF
  434.  
  435.   IF ll_escape
  436.     SET ESCAPE ON
  437.   ELSE
  438.     SET ESCAPE OFF
  439.   ENDIF
  440.  
  441. RETURN
  442. *-- EOP: _Err_Box WITH pc_msg
  443.  
  444.  
  445. // EOP AS_PROC.COD
  446.